home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 25 / Cream of the Crop 25.iso / os2 / kzr0597.zip / ERF.CMD < prev    next >
OS/2 REXX Batch file  |  1997-02-06  |  3KB  |  92 lines
  1. /*  REXX-Programm erf(x) */
  2.  
  3.    Call RxFuncAdd 'SysLoadFuncs', RexxUtil, 'SysLoadFuncs'
  4.    Call SysLoadFuncs
  5.    signal on syntax name erfMsg
  6.  
  7. /* Diese Variablen müssen für jede Prozedur definiert werden, damit die  */
  8. /* Prozedur die Variable bufND kennt und die Variable ND übernehmen kann.*/
  9.    Pfd=SysSearchPath("PATH", "kzr.cmd")
  10.    lp=LastPos("\", Pfd)
  11.    Pfd=DelStr(Pfd, 1+lp)
  12.    NDAerf=Pfd||"NDAerf.DAT"
  13.    bufND =Pfd||"NDZahl.DAT"
  14.    bufMsg=Pfd||"Meldung.DAT"
  15.    ND = LineIn(bufND, 1)
  16.    NDa=ND
  17.  
  18.    if ND > 50 then
  19.    do
  20.      ND=50
  21.      call charout(NDAerf) ; Call SysFileDelete NDAerf
  22.      ret=LineOut(NDAerf, 50)
  23.      Call Charout,"   Achtung, nur  50 Dezimalstellen bei der Berechnung von  erf(...)"
  24.      say
  25.      Beep(444, 200); Beep(628,300)  /* Hier kein EXIT ! */
  26.    end
  27.  
  28.    /* Wenn ND <= 50 ist, wird ND = ND  weitergegeben */
  29.    call charout(NDAerf) ; Call SysFileDelete NDAerf
  30.    ret=LineOut(NDAerf, ND)
  31.  
  32.    numeric digits 125
  33.    /*    1/sqrt(Pi)     */
  34.    c2=0.5641895835477562869480794515607725858440506293289988568440857217106424684414934144867436602021073634430283479063617073516899
  35.    Numeric Digits ND+10
  36.  
  37.    arg x,y
  38.    z=x*x /* Diese Anweisung prvoziert eine Syntax-Fehlermeldung */
  39.  
  40.    if length(y) > 0 then
  41.    do
  42.      call charout(NDAerf) ; Call SysFileDelete NDAerf
  43.      ret=LineOut(bufMsg, "Im Argument von  erf(...)  ist mindestens  1  nicht zulässiges Komma !")
  44.   /* "bufMsg" und  "bufND" werden immer beim Beenden von kzr.cmd gelöscht, */
  45.   /*  damit in den diesbezüglichen temporären Dateien                      */
  46.   /*  Meldungen und ND-Werte nicht aneinandergehängt werden.               */
  47.      EXIT
  48.    end
  49.  
  50.    if x>=0 then sgn=1; else sgn=-1
  51.    x=abs(x)
  52.    if 0    <= x then if x < 4.5  then SIGNAL A
  53.    if 4.5  <= x then if x < 10.5 then SIGNAL B
  54.    if 10.5 <= x then do y=1; SIGNAL C; end
  55.  
  56. A: n=1; u=1; v=1;
  57.    do while u/v>10**(-ND-7)
  58.    g=2*z/(2*n+1); u=u*g; v=v+u; n=n+1; end
  59.    y=2*c2*x*v*exp(-z); Signal C
  60.  
  61. B:
  62.    v10=40/x
  63.    v9 =36/(x+36.5/(x+37/(x+37.5/(x+38/(x+38.5/(x+39/(x+39.5/(x+v10))))))))
  64.    v8 =32/(x+32.5/(x+33/(x+33.5/(x+34/(x+34.5/(x+35/(x+35.5/(x+v9 ))))))))
  65.    v7 =28/(x+28.5/(x+29/(x+29.5/(x+30/(x+30.5/(x+31/(x+31.5/(x+v8 ))))))))
  66.    v6 =24/(x+24.5/(x+25/(x+25.5/(x+26/(x+26.5/(x+27/(x+27.5/(x+v7 ))))))))
  67.    v5 =20/(x+20.5/(x+21/(x+21.5/(x+22/(x+22.5/(x+23/(x+23.5/(x+v6 ))))))))
  68.    v4 =16/(x+16.5/(x+17/(x+17.5/(x+18/(x+18.5/(x+19/(x+19.5/(x+v5 ))))))))
  69.    v3 =12/(x+12.5/(x+13/(x+13.5/(x+14/(x+14.5/(x+15/(x+15.5/(x+v4 ))))))))
  70.    v2 = 8/(x+ 8.5/(x+ 9/(x+ 9.5/(x+10/(x+10.5/(x+11/(x+11.5/(x+v3 ))))))))
  71.    v1 = 4/(x+ 4.5/(x+ 5/(x+ 5.5/(x+ 6/(x+ 6.5/(x+ 7/(x+ 7.5/(x+v2 ))))))))
  72.    v  = 1/(x+ 0.5/(x+ 1/(x+ 1.5/(x+ 2/(x+ 2.5/(x+ 3/(x+ 3.5/(x+v1 ))))))))
  73.  
  74.    y=1-c2*v*exp(-z);
  75.  
  76. C: u=sgn*y
  77.    numeric digits ND
  78.    return(Format(u))
  79.  
  80. erfMsg:
  81.    sf=ErrorText(RC)
  82.    if  Pos("Bad arithmetic conversion", sf) > 0 then
  83.    do
  84.      call charout(NDAerf) ; Call SysFileDelete NDAerf
  85.      ret=LineOut(bufMsg, "Sie haben in  erf(...)  kein gültiges Argument eingegeben !")
  86.   /* "bufMsg" und  "bufND" werden immer beim Beenden von kzr.cmd gelöscht, */
  87.   /*  damit in den diesbezüglichen temporären Dateien                      */
  88.   /*  Meldungen und ND-Werte nicht aneinandergehängt werden.               */
  89.      EXIT
  90.    end
  91.  
  92.